perm filename BRIDG4.SAI[ALS,ALS]1 blob
sn#645549 filedate 1982-03-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "FOURSOME"
C00003 00003 DOI DOK DOM DON DOERR REDOERR DOX EVAL TABL2 TABL3 TABL4 TABL5 TABL6
C00008 00004 $ Main program starts here
C00016 ENDMK
C⊗;
BEGIN "FOURSOME";
DEFINE ⊂="BEGIN",⊃="END",$="COMMENT";
INTEGER ARRAY SET,SET1[0:24,0:9]; $ Trial and best array;
INTEGER ARRAY HIT,HIT1[0:24,0:24]; $ Hits;
INTEGER ARRAY NONO,NONO1[0:24,0:24]; $ Pardners;
INTEGER ARRAY ISAVE,KSAVE,MSAVE,NSAVE,HSAVE[0:49];
INTEGER ARRAY PSAVE,QSAVE[0:192];
INTEGER ARRAY STAY,STAYB,STAYS,STAYO,STAYV,STAYVV[0:25];
INTEGER BOARDS,MMSAVE,PLAYERS,TABLES,ROUNDS;
PRELOAD_WITH 0,1,2,3,4,5,6,7,8;
INTEGER ARRAY TAB,TAB2[0:8];
INTEGER B,H,I,J,K,L,M,MM,N,P,Q,R,T,U,V,W,X,Y,Z;
INTEGER CHAN,HITMAX,HITNUM,HITMA2,HITNU2,HITSUM,HITSUM2,HFINAL,XMAX;
STRING TALLY,SUMMARY;
COMMENT DOI DOK DOM DON DOERR REDOERR DOX EVAL TABL2 TABL3 TABL4 TABL5 TABL6;
PROCEDURE DOI;
⊂ WHILE TRUE DO
⊂ "II"
FOR I←1 STEP 4 UNTIL PLAYERS DO IF SET[I,J]=0 THEN DONE "II";
FOR I←PLAYERS STEP -1 UNTIL 1 DO IF SET[I,J]=0 THEN DONE "II";
⊃ "II";
SET[I,J]←(T LSH 27); ISAVE[B]←PSAVE[X]←I;
OUTSTR(CVS(I)&",");
⊃;
PROCEDURE DOK;
⊂ FOR L←0 STEP 1 UNTIL PLAYERS DO
⊂ "LL"
FOR K←2 STEP 4 UNTIL PLAYERS DO
IF (SET[K,J]=0)∧(NONO[I,K]=0)∧(HIT[I,K]≤L) THEN DONE "LL";
FOR K←PLAYERS STEP -1 UNTIL 1 DO
IF (SET[K,J]=0)∧(NONO[I,K]=0)∧(HIT[I,K]≤L) THEN DONE "LL";
⊃ "LL";
PSAVE[X]←K; QSAVE[X]←L;
KSAVE[B]←PSAVE[X]←K; QSAVE[X]←L;
SET[K,J]←(T LSH 27)+(I LSH 18); NONO[I,K]←NONO[K,I]←1;
SET[I,J]←SET[I,J]+(K LSH 18);
HIT[I,K]←HIT[I,K]+1;
HIT[K,I]←HIT[K,I]+1;
OUTSTR(CVS(K)&",");
⊃;
PROCEDURE DOM;
⊂ FOR Q←0 STEP 1 UNTIL PLAYERS DO
⊂ "QQ"
FOR M←3 STEP 4 UNTIL PLAYERS DO
IF (SET[M,J]=0)∧((HIT[I,M]+HIT[K,M])≤Q) THEN DONE "QQ";
FOR M←PLAYERS STEP -1 UNTIL 1 DO
IF (SET[M,J]=0)∧((HIT[I,M]+HIT[K,M])≤Q) THEN DONE "QQ";
⊃ "QQ";
PSAVE[X]←M; QSAVE[X]←Q;
SET[M,J]←(T LSH 27)+(I LSH 9)+K;
SET[I,J]←SET[I,J]+(M LSH 9); SET[K,J]←SET[K,J]+(M LSH 9);
HIT[M,I]←HIT[M,I]+1; HIT[M,K]←HIT[M,K]+1;
HIT[I,M]←HIT[I,M]+1; HIT[K,M]←HIT[K,M]+1;
MSAVE[B]←PSAVE[X]←M; QSAVE[X]←Q;
OUTSTR(CVS(M)&",");
⊃;
PROCEDURE DON;
⊂ FOR R←0 STEP 1 UNTIL PLAYERS DO
⊂ "RR"
FOR N←4 STEP 1 UNTIL PLAYERS DO
IF (SET[N,J]=0)∧(NONO[M,N]=0)∧((HIT[I,N]+HIT[K,N]+HIT[M,N])≤R) THEN DONE "RR";
FOR N←PLAYERS STEP -1 UNTIL 1 DO
IF (SET[N,J]=0)∧(NONO[M,N]=0)∧((HIT[I,N]+HIT[K,N]+HIT[M,N])≤R) THEN DONE "RR";
⊃ "RR";
PSAVE[X]←N;
SET[N,J]←(T LSH 27)+(M LSH 18)+(I LSH 9)+K;
SET[M,J]←SET[M,J]+N LSH 18;
SET[K,J]←SET[K,J]+N; SET[I,J]←SET[I,J]+N;
NSAVE[B]←PSAVE[X]←N; QSAVE[X]←R;
HIT[I,N]←HIT[N,I]←HIT[I,N]+1; HIT[K,N]←HIT[N,K]←HIT[N,K]+1;
HIT[M,N]←HIT[N,M]←HIT[N,M]+1;
NONO[M,N]←NONO[N,M]←1;
OUTSTR(CVS(N)&" ");
⊃;
PROCEDURE DOERR;
⊂ OUTSTR("DOERR "); ⊃;
PROCEDURE REDOERR;
⊂ OUTSTR("REDOERR "); ⊃;
PROCEDURE DOX;
⊂ Y←(X MOD 4); IF Y=0 THEN Y←4;
CASE Y OF ⊂ DOERR; DOI; DOK; DOM; DON; ⊃;
⊃;
PROCEDURE EVAL;
⊂ OUTSTR("EVAL ");
H←0;
FOR V←1 STEP 1 UNTIL PLAYERS DO
FOR W←1 STEP 1 UNTIL PLAYERS DO IF HIT[V,W]>1 THEN H←H+HIT[V,W]-1;
OUTSTR(" H="&CVS(H)&'15&'12);
⊃;
PROCEDURE TABL2;
⊂ V←V+1; IF V>TABLES THEN ⊂ V←1; U←U+1; ⊃; ⊃;
PROCEDURE TABL3;
⊂ W←W+1; IF W>TABLES THEN ⊂ W←1; TABL2; ⊃; ⊃;
PROCEDURE TABL4;
⊂ X←X+1; IF X>TABLES THEN ⊂ X←1; TABL3; ⊃; ⊃;
PROCEDURE TABL5;
⊂ Y←Y+1; IF Y>TABLES THEN ⊂ Y←1; TABL4; ⊃; ⊃;
PROCEDURE TABL6;
⊂ Z←Z+1; IF Z>TABLES THEN ⊂ Z←1; TABL5; ⊃; ⊃;
$ Main program starts here;
CHAN←1;
WHILE TRUE DO
⊂ "ASK"
OUTSTR("How many tables? "); TABLES←CVD(INCHWL);
PLAYERS←TABLES*4;
IF (TABLES≤1)∨(TABLES>5) THEN
OUTSTR("Sorry, Tallies will be made only for 2 to 5 tables"&'15&'12) ELSE
⊂ OUTSTR("Tallies will be made for "&
CVS(PLAYERS)&" players at "&CVS(TABLES)&" Tables"&'15&'12);
OUTSTR("And now, How many rounds? "); ROUNDS←CVD(INCHWL);
XMAX←PLAYERS*ROUNDS;
IF (ROUNDS>0)∧(ROUNDS<9) THEN DONE "ASK";
⊃;
⊃ "ASK";
T←B←J←0;
FOR X←1 STEP 1 UNTIL XMAX DO
⊂ IF (X MOD 4)=1 THEN
⊂ B←B+1; T←T+1; IF T>TABLES THEN T←1;
IF (B MOD TABLES)=1 THEN
⊂ J←J+1;
OUTSTR('15&'12&"Round "&CVS(J)&'15&'12);
⊃;
⊃;
DOX;
⊃;
EVAL;
Q←1;
FOR P←2 STEP 1 UNTIL TABLES DO Q←Q*P;
FOR I←1 STEP 1 UNTIL PLAYERS DO ⊂ STAYV[I]←99; STAYO[I]← 200; STAYS[I]←566; ⊃;
MMSAVE←0;
FOR J←1 STEP 1 UNTIL ROUNDS DO
⊂ MM←10000;
Z←Y←X←W←V←U←1;
OUTSTR('15&'12&"Round "&CVS(J)&" ");
FOR R←1 STEP 1 UNTIL Q DO
⊂ "LP"
FOR U←U STEP 1 UNTIL TABLES DO
⊂ "UU"
FOR V←V STEP 1 UNTIL TABLES DO
⊂ "VV"
IF V≠U THEN IF TABLES≤2 THEN DONE "UU";
IF (V=U)∧(V=TABLES) THEN DONE "LP";
IF (V=U) THEN CONTINUE "VV";
FOR W←W STEP 1 UNTIL TABLES DO
⊂ "WW"
IF (W≠U)∧(W≠V) THEN IF TABLES≤3 THEN DONE "UU";
IF (W=U)∧(W=V)∧(W=TABLES) THEN DONE "LP";
IF (W=U)∨(W=V) THEN CONTINUE "WW";
FOR X←X STEP 1 UNTIL TABLES DO
⊂ "XX"
IF (X≠U)∧(X≠V)∧(X≠W) THEN IF TABLES≤4 THEN DONE "UU";
IF (X=U)∧(X=V)∧(X=W)∧(X=TABLES) THEN DONE "LP";
IF (X=U)∨(X=V)∨(X=W) THEN CONTINUE "XX";
FOR Y←Y STEP 1 UNTIL TABLES DO
⊂ "YY"
IF (Y≠U)∧(Y≠V)∧(Y≠W)∧(Y≠X) THEN IF TABLES≤5 THEN DONE "UU";
IF (Y=U)∧(Y=V)∧(Y=W)∧(Y=X)∧(Y=TABLES) THEN DONE "LP";
IF (Y=U)∨(Y=V)∨(Y=W)∨(Y=X) THEN CONTINUE "YY";
FOR Z←Z STEP 1 UNTIL TABLES DO
⊂ "ZZ"
IF (Z≠U)∧(Z≠V)∧(Z≠W)∧(Z≠X)∧(Z≠Y) THEN DONE "UU";
IF (Z=U)∧(Z=V)∧(Z=W)∧(Z=X)∧(Z=Y)∧(Z=TABLES) THEN DONE "LP";
⊃ "ZZ";
Z←1;
IF Y=TABLES THEN DONE "YY";
⊃ "YY";
Y←1;
IF X=TABLES THEN DONE "XX";
⊃ "XX";
X←1;
IF W=TABLES THEN DONE "WW";
⊃ "WW";
W←1;
IF V=TABLES THEN DONE "VV";
⊃ "VV";
V←1;
IF U=TABLES THEN DONE "LP";
⊃ "UU";
TAB[1]←U; TAB[2]←V; TAB[3]←W; TAB[4]←X; TAB[5]←Y; TAB[6]←Z;
M←0;
FOR I←1 STEP 1 UNTIL PLAYERS DO
⊂ K←SET[I,J] LSH -27;
L←STAY[I]←TAB[K];
IF L= STAYO[I] THEN
⊂ IF L=STAYS[I] THEN M←M+100;
IF L=STAYV[I] THEN M←M+10; ⊃;
IF ((L=STAYVV[I])∨(L=STAYV[I]))∧(L=STAYS[I]) THEN M←M+1;
⊃;
IF M≤MM THEN
⊂ FOR I←1 STEP 1 UNTIL PLAYERS DO
⊂ K←(SET[I,J] LSH -27); L←TAB[K];
SET1[I,J]← SET[I,J]+(L LSH 27)-(K LSH 27);
STAYB[I]←STAY[I];
⊃;
MM←M;
⊃;
IF MM>MMSAVE THEN MMSAVE←MM;
IF M=0 TH⊃N DONE "LP";
IF TABLES=6 THEN TABL6;
IF TABLES=5 THEN TABL5;
IF TABLES=4 THEN TABL4;
IF TABLES=3 THEN TABL3;
IF TABLES=2 THEN TABL2;
IF U>TABLES THEN DONE "LP";
⊃ "LP";
FOR I←1 STEP 1 UNTIL PLAYERS DO
⊂ SET[I,J]←SET1[I,J];
STAYVV[I]←STAYV[I]; STAYV[I]←STAYO[I]; STAYO[I]←STAYS[I]; STAYS[I]←STAYB[I];
⊃;
OUTSTR(" "&CVS(M));
⊃;
FOR J←1 STEP 1 UNTIL ROUNDS DO
⊂ SUMMARY←SUMMARY&'15&'12&"Round "&CVS(J)&'15&'12;
FOR T←1 STEP 1 UNTIL TABLES DO
⊂ FOR L←1 STEP 1 UNTIL 4 DO TAB[L]←TAB2[L]←0;
FOR I←1 STEP 1 UNTIL PLAYERS DO
⊂ "IL"
L←1; K←SET[I,J] LSH -27;
IF (TAB[L]≠K)∧(TAB2[L+1]≠I)∧(TAB2[L+2]≠I)∧(TAB2[L+3]≠I)THEN
IF (TAB[L]=0)∧(K=T) THEN
⊂ TAB[L]←T; TAB2[L]←I;
TAB2[L+1]←(SET[I,J] LSH -18) LAND '77;
N←(SET[I,J] LSH -9) LAND '77;
P←SET[I,J] LAND '77;
IF P<N THEN ⊂ TAB2[L+2]←P; TAB2[L+3]←N; ⊃
ELSE ⊂ TAB2[L+2]←N; TAB2[L+3]←P; ⊃;
⊃;
⊃ "IL";
FOR L←1 STEP 1 UNTIL 4 DO SUMMARY←SUMMARY&CVS(TAB2[L])&" ";
SUMMARY←SUMMARY&'11;
⊃;
⊃;
TALLY←"\input kermac \input papmac \magnify{1200} \tenpoint \fullpages"
&'15&'12;
P←0;
FOR I←1 STEP 1 UNTIL PLAYERS DO
⊂ "III"
TALLY←TALLY&"\ctrline{\it Player No. "&CVS(I)&"}"&'15&'12&'15&'12
&"$$\vbox{\halign{\hfill#\qquad\hfill⊗\hfill#\qquad"
&"\hfill⊗\hfill#\qquad\hfill⊗\hfill#\hfill\cr\cr"&'15&'12
&"Round⊗Table⊗With⊗Score\cr\cr "&'15&'12;
FOR J←1 STEP 1 UNTIL ROUNDS DO
⊂ "JJJ"
T←LDB(POINT(9,SET1[I,J],8));
K←LDB(POINT(9,SET1[I,J],17));
TALLY←TALLY&CVS(J)&"⊗"&CVS(T)&"⊗"&CVS(K)&"\cr\cr ";
⊃ "JJJ";
TALLY←TALLY&'15&'12&"}}$$"&'15&'12&'15&'12&"\vfill"&'15&'12;
P←P+1; IF (P MOD 2)=0 THEN
TALLY←TALLY&"\eject"&'15&'12 else TALLY←TALLY&"\vskip 1 in"&'15&'12;
⊃ "III";
TALLY←TALLY&'15&'12&"\end"&'15&'12;
CLOSE(CHAN); OPEN(CHAN,"DSK",0,0,2,0,0,0);
ENTER(CHAN,"TALLY.TEX[ALS,ALS]",0);
OUT(CHAN,TALLY); CLOSE(CHAN);
⊃ "FOURSOME";